home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dump_s1r / button.bas next >
Encoding:
BASIC Source File  |  1998-12-20  |  4.2 KB  |  66 lines
  1. Attribute VB_Name = "modButton"
  2. Option Explicit
  3. Public Function CommandToCls(Form As Form) As ComboPack.ButtonMngr
  4.     Set CommandToCls = New ComboPack.ButtonMngr
  5.     Dim cmd
  6.     For Each cmd In Form.Controls
  7.         If TypeName(cmd) = "CommandButton" Then
  8.             CommandToCls.AddButton cmd.Name, cmd.Caption, cmd.Left, cmd.Top, cmd.Width, cmd.Height, cmd.BackColor, cmd.Container, cmd.Picture
  9.             CommandToCls.Buttons(CommandToCls.Count).Enabled = cmd.Enabled
  10.         End If
  11.     Next
  12. End Function
  13.  
  14. Public Function BtnMngrToCode(ButtonMngr As ComboPack.ButtonMngr) As String
  15.     Dim m_lngLoop As Long
  16.     For m_lngLoop = 1 To ButtonMngr.Count
  17.         BtnMngrToCode = BtnMngrToCode & "Private WithEvents " & ButtonMngr.Buttons(m_lngLoop).Name & " As ComboPack.Button" & vbCrLf
  18.     Next
  19.     BtnMngrToCode = BtnMngrToCode & "Private Sub Form_Load()" & vbCrLf
  20.     For m_lngLoop = 1 To ButtonMngr.Count
  21.         BtnMngrToCode = BtnMngrToCode & "Set " & ButtonMngr.Buttons(m_lngLoop).Name & " = New ComboPack.Button" & vbCrLf
  22.         On Error Resume Next
  23.         BtnMngrToCode = BtnMngrToCode & "Set " & ButtonMngr.Buttons(m_lngLoop).Name & ".Parent = " & ButtonMngr.Buttons(m_lngLoop).Parent.Name & vbCrLf
  24.         On Error GoTo 0
  25.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".Left = " & ButtonMngr.Buttons(m_lngLoop).Left & vbCrLf
  26.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".Top = " & ButtonMngr.Buttons(m_lngLoop).Top & vbCrLf
  27.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".Height = " & ButtonMngr.Buttons(m_lngLoop).Height & vbCrLf
  28.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".Width = " & ButtonMngr.Buttons(m_lngLoop).Width & vbCrLf
  29.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".ForeColor = " & ButtonMngr.Buttons(m_lngLoop).ForeColor & vbCrLf
  30.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".BackColor = " & ButtonMngr.Buttons(m_lngLoop).BackColor & vbCrLf
  31.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".Name = """ & ButtonMngr.Buttons(m_lngLoop).Name & """" & vbCrLf
  32.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".Caption = """ & ButtonMngr.Buttons(m_lngLoop).Caption & """" & vbCrLf
  33.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".Redraw" & vbCrLf
  34.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".Enabled = " & ButtonMngr.Buttons(m_lngLoop).Enabled & vbCrLf
  35.     Next
  36.     BtnMngrToCode = BtnMngrToCode & "End Sub" & vbCrLf
  37.     BtnMngrToCode = BtnMngrToCode & "Private Sub Form_MouseDown(Button As Integer, Shift as Integer,X As Single, Y As Single)" & vbCrLf
  38.     For m_lngLoop = 1 To ButtonMngr.Count
  39.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".MouseDown Button, X, Y" & vbCrLf
  40.     Next
  41.     BtnMngrToCode = BtnMngrToCode & "End Sub" & vbCrLf
  42.     BtnMngrToCode = BtnMngrToCode & "Private Sub Form_MouseMove(Button As Integer, Shift as Integer,X As Single, Y As Single)" & vbCrLf
  43.     For m_lngLoop = 1 To ButtonMngr.Count
  44.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".MouseMove Button, X, Y" & vbCrLf
  45.     Next
  46.     BtnMngrToCode = BtnMngrToCode & "End Sub" & vbCrLf
  47.     BtnMngrToCode = BtnMngrToCode & "Private Sub Form_MouseUp(Button As Integer, Shift as Integer,X As Single, Y As Single)" & vbCrLf
  48.     For m_lngLoop = 1 To ButtonMngr.Count
  49.         BtnMngrToCode = BtnMngrToCode & ButtonMngr.Buttons(m_lngLoop).Name & ".MouseUp Button, X, Y" & vbCrLf
  50.     Next
  51.     BtnMngrToCode = BtnMngrToCode & "End Sub" & vbCrLf
  52.     Dim B1 As Button
  53.     Dim B2 As Button
  54.     For Each B1 In ButtonMngr
  55.         BtnMngrToCode = BtnMngrToCode & "Private Sub " & B1.Name & "_Press()" & vbCrLf
  56.         For Each B2 In ButtonMngr
  57.             If B2.Name = B1.Name Then
  58.                 BtnMngrToCode = BtnMngrToCode & B2.Name & ".HasFocus = True" & vbCrLf
  59.             Else
  60.                 BtnMngrToCode = BtnMngrToCode & B2.Name & ".HasFocus = False" & vbCrLf
  61.             End If
  62.         Next
  63.         BtnMngrToCode = BtnMngrToCode & "End Sub" & vbCrLf
  64.     Next
  65. End Function
  66.